home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus Special 17 / AMIGAplus Sonderheft 17 (1999)(ICP)(DE)[!].iso / Rexx / SelectNet.AmiCAD < prev    next >
Text File  |  1998-08-08  |  4KB  |  198 lines
  1. /* Sélection d'une netlist */
  2. /* $VER: NetList 1.0 (© R.Florac, 14-07-98) */
  3. /* Ne teste que les lignes horizontales ou verticales */
  4.  
  5. options results     /* indispensable pour récupérer le résultat des macros */
  6.  
  7. signal on error     /* pour l'interception des erreurs */
  8. signal on syntax
  9.  
  10. 'FIRSTSEL'; i=result
  11. if result~=0 then do
  12.     'NEXTSEL(FIRSTSEL)'
  13.     if result~=0 then i=0
  14. end
  15.  
  16. if i=0 then do
  17.     'PICKOBJ("Cliquez sur la liaison à tester")'
  18.     i=result
  19. end
  20.  
  21. if i=0 then exit
  22.  
  23. /* Test des liaisons */
  24. j=1; nets=0; net.0=""
  25. 'TITLE("Lecture des liaisons en cours..."):LOCK(-1):OBJECTS(-1)'; objets=result
  26.  
  27. /* Initialisation de l'appartenance des objets à une équipotentielle */
  28. net.=-1
  29.  
  30. 'TYPE(O='i')'
  31. if result=2 then do
  32.     'UNMARK(-1):TEST(O)'
  33.     if result=0 then do
  34.     'COORDS(O)'             /* Marquage du fil */
  35.     parse var result x0','y0','x1','y1
  36.     call test_ligne(x0,y0,objets)
  37.     call test_ligne(x1,y1,objets)
  38.     end
  39. end
  40. else do
  41.     'MESSAGE("Sélection incorrecte")'
  42.     exit
  43. end
  44.  
  45. 'TITLE("Test des jonctions...")'
  46. m=1
  47. do while m>0
  48.     m=0
  49.     i=1
  50.     do while i>0
  51.     'OO=FINDOBJ('i',7,-1,-1)'; i=result
  52.     if i>0 then do
  53.         'TEST(OO)'
  54.         if result=0 then do
  55.         'COL(OO)'; x0=result
  56.         'LINE(OO)'; y0=result
  57.         n=test_jonction(x0,y0,objets)
  58.         if n=1 then do        /* la jonction appartient au net */
  59.            'MARK(OO)'
  60.             call marquer_ligne(x0,y0,objets)
  61.             m=1
  62.         end
  63.         end
  64.         if i=objets then i=0
  65.         else i=i+1
  66.     end
  67.     end
  68. end
  69.  
  70. 'TITLE("Recherche des masses...")'
  71. label=""
  72. do i=1 to objets
  73.     'O=FINDPART('i',"MASSE")'; i=result
  74.     if i>0 then do
  75.     j=connexion_broche(i,1)
  76.     if j>0 then do
  77.         'TEST('j')'
  78.         if result=1 then do
  79.         label=0
  80.         leave i
  81.         end
  82.     end
  83.     i=i+1
  84.     end
  85.     else leave
  86. end
  87.  
  88. if label="" then do
  89.     'TITLE("Recherche des labels...")'
  90.     do i=1 to objets
  91.     'TYPE(O='i')'
  92.     if result=4 | result=12 | result=11 then do
  93.         'ABS(FINDLINE(1,COL(O),LINE(O)))'; j=result
  94.         if j>0 then do
  95.         'TEST('j')'
  96.         if result=1 then do
  97.             'READTEXT(O)'; label=result; leave i
  98.         end
  99.         end
  100.     end
  101.     end
  102. end
  103.  
  104. if label="" then do
  105.     'TITLE("Recherche des alimentations...")'
  106.     do i=1 to objets
  107.     'O=FINDPART('i',"ALIMENTATION")'; i=result
  108.     if i>0 then do
  109.         j=connexion_broche(i,1)
  110.         if j>0 then do
  111.         'TEST('j')'
  112.         if result=1 then do
  113.             'READTEXT(GETVAL(O))'; label=result; leave i
  114.         end
  115.         end
  116.         i=i+1
  117.     end
  118.     else leave
  119.     end
  120. end
  121.  
  122. 'TITLE("")'
  123. if label~="" then 'MESSAGE("Équipotentielle 'label'")'
  124. exit
  125.  
  126. test_ligne: procedure expose net.
  127.     parse arg x0,y0,objets
  128.     o=1
  129.     do until o=0
  130.     'X=FINDOBJ('o',2,'x0','y0')'; o=result
  131.     if o>0 then do
  132.         'IF(TEST(X),0,MARK(X):COORDS(X))'
  133.         if result~=0 then do
  134.         net.o=1
  135.         parse var result x1','y1','x2','y2
  136.         if x0=x1 & y0=y1 then call test_ligne(x2,y2,objets)
  137.         else call test_ligne(x1,y1,objets)
  138.         end
  139.         if o=objets then return
  140.         o=o+1
  141.     end
  142.     end
  143.     return
  144.  
  145. marquer_ligne: procedure expose net.
  146.     parse arg x0,y0,objets
  147.     o=1
  148.     do until o=0
  149.     'X=ABS(FINDLINE('o','x0','y0'))'; o=result
  150.     if o>0 then do
  151.         'IF(TEST(X),0,MARK(X):COORDS(X))'
  152.         if result~=0 then do
  153.         net.o=1
  154.         parse var result xl','yl','x1','y1
  155.         call test_ligne(xl,yl,objets)
  156.         call test_ligne(x1,y1,objets)
  157.         end
  158.         if o=objets then return
  159.         o=o+1
  160.     end
  161.     end
  162.     return
  163.  
  164. test_jonction: procedure expose net.
  165.     parse arg xj,yj,objets
  166.     obj=1
  167.     do while obj>0
  168.     'X=ABS(FINDLINE('obj','xj','yj'))'; obj=result
  169.     if net.obj=1 then return 1
  170.     if obj=0 then return 0
  171.     if obj=objets then return 0
  172.     obj=obj+1
  173.     end
  174.     return 0
  175.  
  176. connexion_broche: procedure
  177.     parse arg objet,broche
  178.     'PINCOL(O='objet',B='broche')'; xj=result
  179.     'PINLINE(O,B)'; yj=result
  180.     'FINDOBJ(1,2,'xj','yj')'; xl=result     /* Il y a t'il une ligne qui part de la broche? */
  181.     if xl>0 then return xl
  182.     'FINDLINE(1,'xj','yj')'; xl=result      /* Il y a peut être une ligne qui passe SUR la broche... */
  183.     if xl<=0 then return 0
  184.     'FINDOBJ(1,7,'xj','yj')'                /* Il doit alors y avoir une jonction */
  185.     if result>0 then return xl
  186.     return 0
  187.  
  188. /* Traitement des erreurs, interruption du programme */
  189. syntax:
  190. erreur=RC
  191. 'MESSAGE("Erreur de syntaxe"+CHR(10)+"en ligne 'SIGL'"+CHR(10)+"'errortext(erreur)'")'
  192. exit
  193.  
  194. error:
  195. 'MESSAGE("Erreur en ligne 'SIGL'")'
  196. exit
  197.  
  198.